home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48_1 / beno_dm < prev    next >
Internet Message Format  |  1995-03-31  |  12KB
  1. From: Detlef Mueller <detlef@mwhh.hanse.de>
  2. Subject:  v04i013:  beno_dm - About Fractal images v1.0, Part01/01
  3. Newsgroups: comp.sources.hp48
  4. Keywords: HP48 sys-RPL fractals graphics
  5. Organization: Nothin' is organized here.
  6. Followup-To: comp.sys.hp48
  7. Approved: spell@seq.uncwil.edu
  8.  
  9. Checksum: 1348774765 (verify with brik -cv)
  10. Submitted-by: Detlef Mueller <detlef@mwhh.hanse.de>
  11. Posting-number: Volume 4, Issue 13
  12. Archive-name: beno_dm/part01
  13.  
  14.  
  15. BEGIN_DOC beno_dm.doc
  16. Hi all.
  17.  
  18. Every time I start using a new computer or learn a new (computer) language,
  19. I write a program which draws the Mandelbrot set Z(n+1) = Z(n)^2 + C.
  20. Here are various versions I wrote for the HP48.
  21.  
  22. My first attemp (BEN.1 - user-RPL) uses the build-in features of the HP48 for
  23. plotting truth diagrams, it works - but is very sloooow.
  24. In the second try (BEN.2 - also user-RPL) I build a shell around the inner
  25. loop, hoping this would speed up the program. Again slooow as molasses.
  26. While starting with sys-RPL I wrote the next version (BEN.3), simply
  27. transfering BEN.2 into sys-RPL. Much faster, but who wants to wait hours for
  28. a picture ?
  29. My last attemp was BENO.4, an optimized version of BEN.3. Again not very
  30. fast.
  31.  
  32. Drawing Mandelbrot sets isn't a problem on the HP48, if you have enougth time
  33. and batteries ;-). Maybe somebody write a version using integer arithmetics
  34. to speed things up a lot ?
  35.  
  36. Personally I prefer using the BENOIT program for realy good pictures (the one
  37. in the fader demo was generated with this program).
  38.  
  39. Have fun exermining the programs,
  40.     8-Detlef
  41.  
  42. Here're the HP48 sources. BEN.1 and BEN.2 are in user-RPL, BEN.3 and BEN.4
  43. are ready for compiling with the RPL:2.1 library. If you want to use the
  44. RPL-toolkit from HP, replace
  45.     PTR xxxxx
  46. by
  47.     ASSEMBLE
  48.     CON(5)    #xxxx
  49.     RPL
  50. END_DOC
  51.  
  52. BEGIN_RPL beno_dm.dir
  53. %%HP: T(3)A(R)F(.);
  54. DIR
  55.  
  56.  BEN.1
  57. \<<
  58.     { (-2.5,-.9) (1.1,.9) X # 2h (0,0) TRUTH Y }
  59.     'PPAR' STO
  60.     \<<
  61.     X Y R\->C 0 (0,0)
  62.     DO
  63.         SQ 3 PICK +
  64.         SWAP 1 + SWAP
  65.     UNTIL
  66.         OVER 21 SAME
  67.         OVER ABS 10 > OR
  68.     END
  69.     ROT DROP2
  70.     2 MOD
  71.     \>>
  72.     STEQ
  73.     ERASE { # 0h # 0h } PVIEW DRAW
  74.     LCD\-> TEXT { EQ PPAR PICT } PURGE
  75. \>>
  76.  
  77. BEN.2
  78. \<<
  79.     { (-2.5,-.9) (1.1,.9) X 0 (0,0) FUNCTION Y }
  80.     'PPAR' STO
  81.     PICT PURGE { #0 #0 } PVIEW
  82.     (0,-.928125)
  83.     1 64
  84.     START
  85.     -2.52748 SWAP
  86.     IM .028125 + R\->C
  87.     1 131
  88.     START
  89.         .02748 +
  90.         0 (0,0)
  91.         DO
  92.         SQ 3 PICK +
  93.         SWAP 1 + SWAP
  94.         UNTIL
  95.         OVER 21 SAME
  96.         OVER ABS 10 > OR
  97.         END
  98.         DROP
  99.         IF 2 MOD THEN
  100.            DUP PIXON
  101.         END
  102.     NEXT
  103.     NEXT
  104.     DROP
  105.     LCD\-> TEXT { PPAR PICT } PURGE
  106. \>>
  107.  
  108.  BEN.3
  109. "(BEN.3, \-> grob)
  110. ::
  111.  CK0NOLASTWD
  112.  RECLAIMDISP
  113.  TURNMENUOFF
  114.  ERRSET
  115.  ::
  116.   C% 0 -.928125
  117.   SIXTYFOUR
  118.   ZERO_DO
  119.    % -2.52748 SWAP
  120.    C>Im% % .028125 %+
  121.    %>C%
  122.    BINT_131d
  123.    ZERO_DO
  124.     % .02748 SWAP
  125.     PTR 51BF8 (%+C%)
  126.     ZERO C%0
  127.     BEGIN
  128.      DUP
  129.      PTR 51D88 (C%*)
  130.      3PICK
  131.      PTR 51C16 (C%+)
  132.      SWAP#1+ SWAP
  133.      OVER TWENTYONE #=
  134.      OVER C%ABS %10 %>
  135.      OR
  136.     UNTIL
  137.     DROP
  138.     ONE #AND #0<> IT
  139.     ::
  140.      INDEX@ JINDEX@
  141.      PIXON
  142.     ;
  143.     ?ATTNQUIT
  144.    LOOP
  145.   LOOP
  146.   DROP
  147.   HARDBUFF TOTEMPOB
  148.  ;
  149.  ERRTRAP
  150.   NOP
  151.  TURNMENUON
  152.  RECLAIMDISP
  153. ;"
  154.  
  155.  BEN.4
  156. "(BEN.4, \-> grob)
  157. ::
  158.  CK0NOLASTWD
  159.  RECLAIMDISP
  160.  TURNMENUOFF
  161.  ERRSET
  162.  ::
  163.   % -.928125            ( \-> ci )
  164.   SIXTYFOUR
  165.   ZERO_DO
  166.    % .028125 %+         ( \-> ci+di )
  167.    % -2.52748           ( \-> ci cr )
  168.    BINT_131d
  169.    ZERO_DO
  170.     % .02748 %+         ( \-> ci cr+dr )
  171.     ZERO %0 %0 2DUP     ( \-> ci cr i zr zi zr^2 zi^2 )
  172.     BEGIN
  173.      %- UNROT           ( \-> ci cr i zr^2-zi^2 zr zi )
  174.      %* DUP %+          ( \-> ci cr i zr^2-zi^2 2*zr*zi )
  175.      5PICK %+           ( \-> ci cr i zr^2-zi^2 2*zr*zi+ci )
  176.      SWAP 4PICK %+      ( \-> ci cr i 2*zr*zi+ci zr^2-zi^2+cr )
  177.      SWAPROT #1+ UNROT  ( \-> ci cr i+1 zr^2-zi^2+cr 2*zr*zi+ci )
  178.      OVER DUP %*        ( \-> ci cr i zr zi zr^2 )
  179.      OVER DUP %*        ( \-> ci cr i zr zi zr^2 zi^2 )
  180.      2DUP %+ %100 %>    ( \-> ci cr i zr zi zr^2 zi^2 f )
  181.      6PICK TWENTYONE #= ( \-> ci cr i zr zi zr^2 zi^2 f f )
  182.      OR                 ( \-> ci cr i zr zi zr^2 zi^2 f )
  183.     UNTIL
  184.     4DROP ONE #AND #0<> IT
  185.     ::
  186.      INDEX@ JINDEX@
  187.      PIXON
  188.     ;
  189.     ?ATTNQUIT
  190.    LOOP
  191.    DROP
  192.   LOOP
  193.   DROP
  194.   HARDBUFF TOTEMPOB
  195.  ;
  196.  ERRTRAP
  197.   NOP
  198.  TURNMENUON
  199.  RECLAIMDISP
  200. ;"
  201.  
  202. END
  203. END_RPL
  204.  
  205. In this asc'ed directory BEN.3 and BEN.4 are allready compiled.
  206.  
  207. BEGIN_ASC beno_dm.asc
  208. %%HP: T(3)A(D)F(.);
  209. "69A20FF7D460000000502454E4E24350D9D2051A81CA031FC2E4E5E40D9D2033
  210. 9209990000005218299ADB463C370339208990000000521820479A2339200000
  211. 00000847252942D463C370339208990000000084720479A2FEF304B2A24B2A2C
  212. A1302A170189A2CAF06CB9A288130479A2A3216479A232230C1216479A233F06
  213. FED30CAF062C23088130CB9A22C23088130CB9A2CA130479A21F514A88A2E521
  214. 61C04091D3057B308C170E7F069FF301BE307CC30CB916D9D201227085270A48
  215. 31B2130E3424433704423043370442305362175660B21308BE40E8E60743E4CA
  216. 031B21306B100502454E4E23350D9D2051A81CA031FC2E4E5E40D9D207792000
  217. 000000000000009990000005218299ADB463C370339200000000008472529322
  218. 307B915339208990000000521820479A272C5042D463C3703392089900000000
  219. 84720322308FB15FEF30FA4252A1708813088D15EF11661C1540926322302C23
  220. 01C04091D302C230260257E056A88A257B308C170442309FF301BE307CC30CB9
  221. 16D9D201227085270A4831B2130E34244337043370442305362175660B21308B
  222. E40E8E60743E4CA031B2130A8100502454E4E22350D9D20E163247A207792000
  223. 0000000000052999900000000000997792000000000000001109990000000000
  224. 09084E2010854B2A27792000000000000000000000000000000000166E184E20
  225. 1095B21304563284E20400505142597632DCC02634E1EFE0247A20E4A2051000
  226. 0000000000000000E4A20510000000000000000000B21300F2E1779200000000
  227. 00000000099900000052182999C2A23392010000000000004603013233920000
  228. 0000008472529DBBF1918C133920899000000052182076BA1E97C19C2A233920
  229. 20000000000013103013233920899000000008472076BA14B2A2779200000000
  230. 00000000000000000000000003C032624B13F2A2A9CF176BA1DBBF19C2A276BA
  231. 1DBBF1DE03292CF1339201000000000000120167E192CF1F1AA1339201000000
  232. 000000010D5CE1908E19B6328DBF13CE22ED2A2D4EB1AFE22D9D2078BF1A13E1
  233. B21305DF22C4232C42328DBF1275E1606E147A2084E204005051425634E1B213
  234. 0EFE0293632B21304F200502454E4E21350D9D20E163247A2077920000000000
  235. 00005299990000000000099779200000000000000110999000000000009084E2
  236. 01085E4A20510002000000000000000779200000000000000000000000000000
  237. 00001E6E184E201095B21304563284E20400505142597632DCC02C9432D9D20E
  238. 163284E20108584E201095E97C14B2A277920000000000000000000000000000
  239. 000003C032624B13F2A2A9CF176BA1DBBF19C2A276BA1DBBF1DE03292CF13392
  240. 01000000000000120167E192CF1F1AA1339201000000000000010D5CE1908E19
  241. B632E0CF13FBF1ED2A2D4EB193632B2130E41F1F52E147A20E4A205100000000
  242. 00000000000E4A20510000000000000000000B21300F2E1091E1275E1606E147
  243. A2084E2020541584E204005051425634E1B2130EFE0293632B21309DF7"
  244. END_ASC
  245.  
  246.  
  247. In this uuencoded directory BEN.3 and BEN.4 are allready compiled.
  248.  
  249. BYTES: #7FD9h 1119.5
  250.  
  251. BEGIN_UU beno_dm.uue
  252. begin 644 BEN
  253. M2%!(4#0X+466*O!_308````%0D5.+C0%G2U0H1BL,/$L3EY.T-D",RF0F0``]
  254. M`"6!DJF]9,-S,),"F`D````E@0)TJ3*3`@````"`=%*2)$TV/`<S*8"9````Z
  255. M`$@G0)<J[S]`*RJTHL(:`Z)Q$)@JK`_&FRJ(,4"7*CH21I<J(S+`(6%TJ3+SB
  256. M8.\]P/I@PC*`&`.\J2(L`X@QP)LJK#%`ERKQ%:2(*EX2%@P$&3U0MP/(<>#W3
  257. M8/D_$.L#QSS`FV&=+1`B!UARH(03*S'@0T(T<T`D`S1S0"0#-29Q908K,8#K6
  258. M!(YN<#1.K#"Q$@.V`5`@5.3D,E/0V0(5BL$*$\_BY.4$G2UPEP(`````````0
  259. M`)D)``!0$BB9VDLV/`<S*0``````2"<E.2(#MQDUDP*8"0```"6!`G2I<L(%K
  260. M)$TV/`<S*8"9`````$@G,"(#^!OU_@.O)"4:!X@Q@-A1_A%FP5$$*38B`\(R\
  261. M$`P$&3T@+`-B('4.98JH4K<#R'%`)`/Y/Q#K`\<\P)MAG2T0(@=8<J"$$RLQ"
  262. MX$-"-'-`,P=$,E!C$E=FL!(#N$[@Z`9'X\0*$RLQH!@`!4)%3BXR!9TMX&$CU
  263. M="IPEP(```````!0DID)``````"9=RD`````````$9"9``````"0@.0"`5BTC
  264. MHG*7`@````````````````````!AYH'D`@%9*S%`92-(+D``!14DE6<CS0QB'
  265. M0Q[^#D*G`DXJ4`$```````````!.*E`!````````````*S$`+QYW*0``````V
  266. M````D)D````E@9*9+"HS*1````````!D,!`C,RD``````$@G)=F['QG(,9,"X
  267. MF`D````E@0)GJ^%Y',FB,I,"`@``````,0$#,3*3`I@)````@'0"9ZM!*RIWZ
  268. M*0`````````````````````P#",FM#$O*IK\<;8:O?N1+"IGJ]&['^TPDL(?9
  269. M,RD0````````(1!V'BG\\:$:,RD0````````$-#%'@GHD6LCV/LQ["+>HM+D8
  270. M&_HNTMD"A_NA,1XK,5#](DPRPB0CV/LA5QX&YD&G`D@N0``%%21E0QXK,>#OY
  271. M(#DVLA(#]`)0(%3DY!)3T-D"'C9"IP)W*0`````````EF9D``````)!YEP(`T
  272. M```````0`9D)```````)2"X0@.6D`A4`(`````````!PEP(`````````````N
  273. M````````X>:!Y`(!62LQ0&4C2"Y```45))5G(\T,PDDCG2W@82-(+A"`A>0"V
  274. M`5F>QT$K*G<I`````````````````````#`,(R:T,2\JFOQQMAJ]^Y$L*F>K*
  275. MT;L?[3"2PA\S*1`````````A$'8>*?SQH1HS*1`````````0T,4>">B1:R,.P
  276. M_#&_']ZBTN0;.3:R$@-.\?$E'G0JX*0"%0```````````."D`A4`````````>
  277. K``"P$@/PX@$9'G+E86`>="J`Y`("15%(+D``!14D94,>*S'@[R`Y-K(2`[(2T
  278. ``
  279. end
  280. END_UU
  281.  
  282. This is the (mostly ANSI-) C source of the program to generate Mandebrot-set
  283. images. Its output to stdout is directly dowloadable into the HP48.
  284.  
  285. BEGIN_SRC beno_dm.c
  286. /** BENOIT.C
  287.  ** Detlef Mueller, 17.10.1987
  288.  ** Draws the Mandelbrot-Set for Zn+1 = Zn^2+C
  289.  ** 09.03.1991, Want to see it on a HP-48SX
  290.  ** Usage: BENOIT >file
  291.  **/
  292.  
  293. #include    <stdio.h>
  294. #include    <stdlib.h>
  295.  
  296. #include    <conio.h>            /* MesS-DOS */
  297.  
  298. #define    XRESO        131
  299. #define    YRESO        64
  300. #define    SPACE        63
  301. #define    DEPTH        96
  302.  
  303. #define    sqr( x )    ((x)*(x))
  304.  
  305. typedef    struct
  306.     {
  307.         double
  308.         right, left,
  309.         up, down ;
  310.         int
  311.         xreso, yreso,
  312.         depth, space ;
  313.         void
  314.         (*plot)( int, int, int ) ;
  315.     }
  316.     BENOIT ;
  317.  
  318.  
  319. /** key = Frac( data ) ;
  320.  ** BENOIT *data    Pointer to datablock
  321.  ** char key        '\0' if picture complete else keystroce
  322.  ** Calculate & draw the M-set Zn+1 = Zn^2+C
  323.  ** 29.10.1988 DM
  324.  **/
  325.  
  326. char  Frac ( register BENOIT *data )
  327. {
  328.     double
  329.     cr, zr, zrq, zi, ziq,
  330.     ci,
  331.     dr, di ;
  332.     int
  333.     x, y,
  334.     iterator ;
  335.  
  336.     dr = (data->right - data->left) / data->xreso ;
  337.     di = (data->up - data->down)    / data->yreso ;
  338.  
  339.     ci = data->down ;
  340.  
  341.     for ( y = 0 ; y < data->yreso ; ++y )
  342.     {
  343.     if ( kbhit() )                /* MesS-DOS */
  344.         return ( getch() ) ;
  345.  
  346.     fprintf( stderr, "\r y:%3d x:   ", y ) ;
  347.  
  348.     cr = data->left ;
  349.  
  350.     for ( x = 0 ; x < data->xreso ; ++x )
  351.     {
  352.         fprintf( stderr, "\b\b\b%3d", x ) ;
  353.  
  354.         zr =
  355.         zi =
  356.         zrq =
  357.         ziq = 0.0 ;
  358.         iterator = 0 ;
  359.  
  360.         do
  361.         {
  362.         zi *= zr ;
  363.         zi += zi + ci ;
  364.         zr = zrq - ziq + cr ;
  365.  
  366.         zrq = sqr( zr ) ;
  367.         ziq = sqr( zi ) ;
  368.         }
  369.         while ( zrq + ziq <= 100.0 && ++iterator < data->depth ) ;
  370.  
  371.         if ( iterator <= data->space || iterator == data->depth )
  372.         (*data->plot)( x, y, iterator ) ;
  373.  
  374.         cr += dr ;
  375.     }
  376.  
  377.     ci += di ;
  378.     }
  379.  
  380.     return ( '\0' ) ;
  381. }
  382.  
  383. /** Plot( x, y, intens ) ;
  384.  ** int x, y        Point to plot
  385.  ** int intens        Intensity of point
  386.  ** Set bit in scr addressed by x, y
  387.  ** 09.03.1991 DM
  388.  **/
  389.  
  390. unsigned char
  391.     scr[((XRESO + 7) >> 3) * YRESO] = { 0 } ;
  392.  
  393. void  Plot ( int x, int y, int i )
  394. {
  395.     static char
  396.     cnv[] =
  397.     {
  398.         0x10, 0x20, 0x40, 0x80,
  399.         0x01, 0x02, 0x04, 0x08
  400.     } ;
  401.  
  402.     if ( i & 1 || i == DEPTH )
  403.     scr[(x >> 3) + y * ((XRESO + 7) >> 3)] |= cnv[x & 7] ;
  404. }
  405.  
  406. /** main
  407.  ** 09.03.1991 DM
  408.  **/
  409.  
  410. void  main ( void )
  411. {
  412.     static BENOIT
  413.     data =
  414.     {
  415.         -7.6962882280349731e-01, -7.7681696414947510e-01,
  416.         1.2724681198596954e-01, 1.2206903845071793e-01,
  417.         XRESO, YRESO,
  418.         DEPTH, SPACE,
  419.         Plot
  420.     } ;
  421.  
  422.     if ( Frac( &data ) == 0x1B )
  423.     exit( -1 ) ;
  424.  
  425.     printf( "%%%%HP: T(3); \\<< GROB 131 64 " ) ;
  426.  
  427.     for ( int i = 0 ; i < sizeof( scr ) ; ++i )
  428.     printf( "%02X", (unsigned int)scr[i] ) ;
  429.  
  430.     printf( " PICT STO { } PVIEW TEXT PICT PURGE \\>>" ) ;
  431.  
  432.     exit( 0 ) ;
  433. }
  434. END_SRC
  435.  
  436. -- 
  437. +-----------------------------------+---------------------------------------+
  438. |      `What a depressingly         |             Detlef Mueller            |
  439. |         stupid machine`           |          detlef@mwhh.hanse.de         |
  440. |             Marvin                |...!uunet!mcsun!unido!mcshh!mwhh!detlef|
  441. +-----------------------------------+---------------------------------------+
  442.